;=================================================
; object reorientation sample
;
(load "common.lsp")

;(defclass name (direct-superclass-name*)
;  (slot-specifier*))
;
; === bank account ===
;
; (defclass bank-account () ...)
; (defclass checking-account (bank-account) ...)
; (defclass savings-account (bank-account) ...)
;

;=================================================
; slot specifiers sample
;
(defclass bank-account-1 ()
 (customer-name
  balance)
 )

(defun test-1 ()
 (setf x-account (make-instance 'bank-account-1))

 ; accessing slots
 ; setters:
 (setf (slot-value x-account 'customer-name) "John Doe")
 (setf (slot-value x-account 'balance) 20000000)

 (trace-fn "x-account access test:"
  x-account

  ; getters:
  (slot-value x-account 'customer-name)
  (slot-value x-account 'balance)
  )
 )

;=================================================
; initialization
(defclass bank-account-2 ()
 ((customer-name :initarg :customer-name)
  (balance :initarg :balance :initform 0))
 )

(defun test-2 ()
 (setf x-account-1 (make-instance 'bank-account-2
                  :customer-name "Chuck Berry" :balance 1200))
 (trace-fn "2 test:"
  x-account-1
  (slot-value x-account-1 'customer-name)
  (slot-value x-account-1 'balance)
  )
 )

;=================================================
; more fun with defclass
;
(defvar *account-numbers-3* 0)

(defclass bank-account-3 ()
  (
   ; customer name slot
   (customer-name
    :initarg :customer-name
    :initform (error "Must supply a customer name."))
   
   ; customer balance slot
   (balance
    :initarg :balance
    :initform 17)

   ; customer's account number
   (account-number
    :initform (incf *account-numbers-3*))
   
   ; customer account's type
   ; initialized later in the ctor defined later
   account-type
   ))

(defun test-3 ()
 (trace-fn "test-3:"
  (slot-value (make-instance 'bank-account-3
               :customer-name "Andrew Koenig") 'balance)
  *account-numbers-3*
  )
 )

;=================================================
; initialize-instance sample (like to C++ constructors)
;
; :DOC:
; However, while an initform can be any Lisp expression, it has no access to the object being initialized, so it can't initialize one slot based on the value of another. For that you need to define a method on the generic function INITIALIZE-INSTANCE.
;
; &key is required to keep the method's parameter list congruent with the generic function's--the parameter list specified for the INITIALIZE-INSTANCE generic function includes &key in order to allow individual methods to supply their own keyword parameters but doesn't require any particular ones
;
(defmethod initialize-instance :after ((account-inst bank-account-3) &key)
 (let ((balance (slot-value account-inst 'balance)))
  (setf (slot-value account-inst 'account-type)
   (cond
        ((>= balance 100000) :gold)
        ((>= balance 50000) :silver)
        (t :bronze)
        ) ; cond
   ) ; setf
  ) ; let
 )

(defun test-4 ()
 (setf acc-4
  (make-instance 'bank-account-3 :customer-name "Alexander S" :balance 5000000))

 (trace-fn "test-4:" (slot-value acc-4 'account-type))
 )

;=================================================
; more keyword parameters
;
(defclass bank-account-4 ()
  (
   ; customer name slot
   (customer-name
    :initarg :customer-name
    :initform (error "Must supply a customer name."))
   
   ; customer balance slot
   (balance
    :initarg :balance
    :initform 17)
   ))


(defmethod initialize-instance :after ((account bank-account-4)
                                       &key opening-bonus-percentage)
  (when opening-bonus-percentage
    (incf (slot-value account 'balance)
     (* (slot-value account 'balance) (/ opening-bonus-percentage 100))
     )
    ) ; when
  )

(defun test-5 ()
 (setf acc-5 (make-instance 'bank-account-4 :customer-name "Lisa Gardner" :balance 1000 :opening-bonus-percentage 5))
 (trace-fn "test-5:" (slot-value acc-5 'balance))
 )

;=================================================
; accessor functions
;

; accessor function sample 1:
(defun balance-1 (account) (slot-value account 'balance))

; if you know you're going to define subclasses of bank-account, it might be a good idea to define balance as a generic function. That way, you can provide different methods on balance for those subclasses or extend its definition with auxiliary methods.
(defgeneric balance-2 (account))

(defmethod balance-2 ((account bank-account-4))
 (slot-value account 'balance)
 )


; SETTER sample - use it by defining one another version of setf
(defun (setf customer-name) (name account)
 (setf (slot-value account 'customer-name) name)
 )

; generic setter/getter versions
(defgeneric (setf customer-name-1) (value account))

(defmethod (setf customer-name-1) (value (account bank-account-4))
  (setf (slot-value account 'customer-name) value))

; And of course you'll also want to define a reader function for customer-name.
(defgeneric customer-name-1 (account))

(defmethod customer-name-1 ((account bank-account-4))
  (slot-value account 'customer-name))


(defun test-6 ()

 (setf (customer-name acc-5) "Sergey Brinn")

 (trace-fn "accessors test-6:"
  (balance-1 acc-5)
  (balance-2 acc-5)

  ; one another variance
  (slot-value acc-5 'customer-name)

  ; setter/getter
  (setf (customer-name-1 acc-5) "Larry Alison")
  (customer-name-1 acc-5)
  )
 )


;=================================================
; one another reader/writer sample
;

; Thus, instead of explicitly writing the balance generic function and method as shown previously, you could change the slot specifier for the balance slot in the definition of bank-account to this
(defclass bank-account-5 ()
  (
   ; customer name slot
   (customer-name
    :initarg :customer-name
    :initform (error "Must supply a customer name.")
    :reader the-cust-name
    :writer (setf the-cust-name)
    )

   ; account master clerk
   (clerk
    :initarg :clerk
    :initform "Frenkel-the-clerk"
    ; the same as reader/writer
    :accessor the-clerk
    )
   
   ; customer balance slot
   (balance
    :initarg :balance
    :initform 0
    :reader get-the-balance
    )
   ))

(defun test-7 ()
 (setf acc1 (make-instance 'bank-account-5 :customer-name "Vovka"))

 (trace-fn "test-7" (the-clerk acc1))
 )


;=================================================
; my-class
;
(defclass co-employee-1 ()
 (
  ; name in the system
  (e-name
   :initarg :e-name :initform "Anonymous" :reader e-name)

  ; balance
  (balance :initarg :balance :reader get-balance)

  ; bonus persentage
  (bonus-p :initarg bp :initform 5.0 :accessor bonus-p)

  ; penalty
  (penalty :initform 0 :accessor penalty)
  ()
 )) ; class co-employee-1

; test method
(defmethod warn-penalty ((x co-employee-1))
 (when (< (get-balance x) 10)
  (progn
   (format t "balance too low!!!~%")
   (setf (penalty x) (* (get-balance x) 0.1))
  )
  )
 )
 

; tester
(defun co-test-1 ()
 (let ((x (make-instance 'co-employee-1 :balance 5)))

  ; test reader
  (format t "name: '~a'~%" (e-name x))

  (warn-penalty x)

  (format t "penalty = ~a~%" (penalty x))

  ;
  )
 )

;=================================================
;=================================================
; general test function
;
(defun test ()
 (test-1)
 (off test-2)
 (off test-3)
 (off test-4)
 (off test-5)
 (off test-6)
 (off test-7)
 (co-test-1)
 )

;=================================================
; app entry point
;
(defun main ()

 (format t "object reorientation~%")

 (test)

 (exit)
 )

;=================================================
; executes main
;
(main)
